home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / languages / fpl-v115.lha / FPL / src / statement.c < prev   
Encoding:
C/C++ Source or Header  |  1995-03-09  |  45.5 KB  |  1,863 lines

  1. /******************************************************************************
  2.  *                   FREXX PROGRAMMING LANGUAGE                  *
  3.  ******************************************************************************
  4.  
  5.  statement.c
  6.  
  7.  Support routines to the Expression() function.
  8.  
  9.  *****************************************************************************/
  10.  
  11. /************************************************************************
  12.  *                                                                      *
  13.  * fpl.library - A shared library interpreting script langauge.         *
  14.  * Copyright (C) 1992-1994 FrexxWare                                    *
  15.  * Author: Daniel Stenberg                                              *
  16.  *                                                                      *
  17.  * This program is free software; you may redistribute for non          *
  18.  * commercial purposes only. Commercial programs must have a written    *
  19.  * permission from the author to use FPL. FPL is *NOT* public domain!   *
  20.  * Any provided source code is only for reference and for assurance     *
  21.  * that users should be able to compile FPL on any operating system     *
  22.  * he/she wants to use it in!                                           *
  23.  *                                                                      *
  24.  * You may not change, resource, patch files or in any way reverse      *
  25.  * engineer anything in the FPL package.                                *
  26.  *                                                                      *
  27.  * This program is distributed in the hope that it will be useful,      *
  28.  * but WITHOUT ANY WARRANTY; without even the implied warranty of       *
  29.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                 *
  30.  *                                                                      *
  31.  * Daniel Stenberg                                                      *
  32.  * Ankdammsgatan 36, 4tr                                                *
  33.  * S-171 43 Solna                                                       *
  34.  * Sweden                                                               *
  35.  *                                                                      *
  36.  * FidoNet 2:201/328    email:dast@sth.frontec.se                       *
  37.  *                                                                      *
  38.  ************************************************************************/
  39.  
  40. #ifdef AMIGA
  41. #include <exec/types.h>
  42. #include <proto/exec.h>
  43. #include <stdlib.h>
  44.  
  45. #include <proto/dos.h>
  46. #include <exec/execbase.h>
  47. #include <dos.h>
  48.  
  49. #include "/funclib/funclib.h"
  50.  
  51. #elif defined(UNIX)
  52. #include <sys/types.h>
  53. #endif
  54.  
  55. #include "script.h"
  56. #include "debug.h"
  57. #include <stdio.h>
  58. #include <stddef.h>
  59. #include <limits.h>
  60.  
  61. static ReturnCode INLINE SendMessage(struct Data *, struct fplMsg *);
  62. static ReturnCode REGARGS Ltostr(struct Data *scr, struct fplStr **,
  63.                      long, long);
  64. static ReturnCode REGARGS GetSymbols(struct Data *, long, long,
  65.                                      struct fplSymbol **);
  66. static long REGARGS my_memicmp(char *, char *, long);
  67.  
  68. /**********************************************************************
  69.  *
  70.  * ReturnCode CmpAssign()
  71.  *
  72.  * Performs a compound assign to the value the third argument points to.
  73.  * The assign performed is the one with the operator specified in the fourth
  74.  * argument eg, x, +, /, &, %, | etc, etc...
  75.  *
  76.  ***************/
  77.  
  78. ReturnCode REGARGS
  79. CmpAssign(struct Data *scr,
  80.           long val,    /* right operand */
  81.       long *value,    /* return value pointer */
  82.       long flags,    /* variable flags */
  83.       char operation)
  84. {
  85.   ReturnCode ret;
  86.   switch(operation) { /* check the type of the assign */
  87.   case CHAR_PLUS:
  88.     *value+=val;
  89.     break;
  90.   case CHAR_MINUS:
  91.     *value-=val;
  92.     break;
  93.   case CHAR_MULTIPLY:
  94.     *value*=val;
  95.     break;
  96.   case CHAR_DIVIDE:
  97.     *value/=val;
  98.     break;
  99.   case CHAR_AND:
  100.     *value&=val;
  101.     break;
  102.   case CHAR_OR:
  103.     *value|=val;
  104.     break;
  105.   case CHAR_REMAIN:
  106.     *value%=val;
  107.     break;
  108.   case CHAR_XOR:
  109.     *value^=val;
  110.     break;
  111.   case CHAR_LESS_THAN:
  112.     *value<<=val;
  113.     break;
  114.   case CHAR_GREATER_THAN:
  115.     *value>>=val;
  116.     break;
  117.   case CHAR_ASSIGN:
  118.     *value=val;
  119.     break;
  120.   default:
  121.     CALL(Warn(scr, FPLERR_ILLEGAL_ASSIGN)); /* >warning< */
  122.     *value=val; /* perform a straight assign! */
  123.     break;
  124.   }
  125.   if(flags&FPL_VARIABLE_LESS32) {
  126.     /* if using less than 32 bit */
  127.     if(flags&FPL_CHAR_VARIABLE)
  128.       *value=(long)((signed char)*value);
  129.     else
  130.       *value=(long)((signed short)*value);
  131.   }
  132.   return(FPL_OK);
  133. }
  134.  
  135.  
  136. /**********************************************************************
  137.  *
  138.  * StrAssign();
  139.  *
  140.  * Assign a string variable.
  141.  *
  142.  ********/
  143.  
  144. ReturnCode REGARGS
  145. StrAssign(struct fplStr *app,
  146.           struct Data *scr,
  147.       struct fplStr **string,
  148.       char append) /* TRUE or FALSE if append */
  149. {
  150.   ReturnCode ret;
  151.  
  152.   if(!append) { /* if not append */
  153.     /* Exchange this string with the old one in the variable! */
  154.     if(*string) {
  155.       /*
  156.        * There is a string! Free any type!
  157.        */
  158.       FREE_KIND(*string);
  159.     }
  160.     if(!app) {
  161.       GETMEM(app, sizeof(struct fplStr));
  162.       memset(app, 0, sizeof(struct fplStr)); /* clean it! */
  163.     }
  164.     *string = app;
  165.  
  166.   } else { /* append string */
  167.     if(! (app?app->len:0))
  168.       /* we don't append zero length strings! */
  169.       return FPL_OK;
  170.  
  171.     CALL(AppendStringToString(scr, string, app->string, app->len));
  172.  
  173.   }
  174.   return(FPL_OK);
  175. }
  176.  
  177. /************************************************************************
  178.  *
  179.  * AppendStringToString()
  180.  *
  181.  * Append a generic string to a fplStr.
  182.  *
  183.  */
  184.  
  185. ReturnCode REGARGS
  186. AppendStringToString(struct Data *scr,  /* common data struct */
  187.              struct fplStr **string, /* variable to append to */
  188.              char *append, /* string to append */
  189.              long applen)  /* length of append string */
  190. {
  191.     long length;
  192.     long alloc;
  193.     long ln;
  194.     struct fplStr *pek;
  195.     ReturnCode ret;
  196.     void *dest;
  197.     char type = *string?TypeMem(*string):MALLOC_DYNAMIC;
  198.  
  199.     length=*string?(*string)->len:0;
  200.     alloc=*string?(*string)->alloc:0;
  201.  
  202.     ln = applen + length; /* total length */
  203.     if (ln>=alloc) { /* do we have that much memory allocated? */
  204.       /*
  205.        * Allocate new memory for string.
  206.        */
  207.  
  208.       GETMEM(pek, sizeof(struct fplStr)+ln+ADDSTRING_INC);
  209.       if(MALLOC_STATIC == type)
  210.         SwapMem(scr, pek, MALLOC_STATIC);
  211.  
  212.       if(*string) {
  213.         memcpy(pek, (*string), length+sizeof(struct fplStr));
  214.         FREE_KIND(*string);
  215.       } else
  216.     pek->len=0;
  217. #ifdef DEBUG
  218.       CheckMem(scr, pek);
  219. #endif
  220.       (*string)=pek;              /* the new pointer */
  221.       (*string)->alloc=ln+ADDSTRING_INC;  /* new allocated size */
  222.     }
  223.  
  224.     dest=(void *)&(*string)->string[length];
  225.  
  226.     /* no string function... only mem-versions! */
  227.     memcpy(dest, (void *)append, applen);
  228.  
  229.     (*string)->len += applen;
  230.  
  231.     (*string)->string[(*string)->len]=CHAR_ASCII_ZERO; /* zero terminate */
  232.  
  233.     return FPL_OK;
  234. }
  235.  
  236.  
  237. /************************************************************************
  238.  *
  239.  * ReturnChar()
  240.  *
  241.  * Returns the ASCII code of the character scr->text points to.
  242.  *
  243.  * Supports 100% ANSI C escape sequences.
  244.  */
  245.  
  246. ReturnCode REGARGS
  247. ReturnChar(struct Data *scr,
  248.            long *num,
  249.            char string) /* is this is within quotes */
  250. {
  251.   ReturnCode ret=FPL_OK;
  252.   long cont=TRUE, steps;
  253.   *num=256;
  254.   while(cont) {
  255.     cont=FALSE;
  256.     if(*scr->text==CHAR_BACKSLASH) {
  257.       steps=2;
  258.       switch(scr->text[1]) {
  259.       case CHAR_B:
  260.     *num=CHAR_BACKSPACE;
  261.     break;
  262.       case CHAR_T:
  263.     *num=CHAR_TAB;
  264.     break;
  265.       case CHAR_N:
  266.     *num=CHAR_NEWLINE;
  267.     break;
  268.       case CHAR_F:
  269.     *num=CHAR_FORMFEED;
  270.     break;
  271.       case CHAR_BACKSLASH:
  272.     *num=CHAR_BACKSLASH;
  273.     break;
  274.       case CHAR_QUOTATION_MARK:
  275.     *num=CHAR_QUOTATION_MARK;
  276.     break;
  277.       case CHAR_APOSTROPHE:
  278.     *num=CHAR_APOSTROPHE;
  279.     break;
  280.       case CHAR_A:
  281.     *num=CHAR_ALERT;
  282.     /*   ^^^^ causes warnings ('warning: \a is ANSI C "alert" character')
  283.      * on some compilers. Ignore and look happy!
  284.      */
  285.     break;
  286.       case CHAR_R:
  287.     *num=CHAR_CARRIAGE_RETURN;
  288.     break;
  289.       case CHAR_V:
  290.     *num=CHAR_VERTICAL_TAB;
  291.     break;
  292.       case CHAR_QUESTION:
  293.     *num=CHAR_QUESTION;
  294.     break;
  295.       case CHAR_X:
  296.     steps=*num=0;
  297.     for(scr->text+=2; steps++<2 && isxdigit(*scr->text); scr->text++)
  298.       *num=*num*16+ (isdigit(*scr->text)?
  299.                          *scr->text-CHAR_ZERO:
  300.                          UPPER(*scr->text)-CHAR_UPPER_A+10);
  301.         if(!steps)
  302.       return(FPLERR_SYNTAX_ERROR); /* no number followed \x sequence */
  303.     steps=0;
  304.     break;
  305.       case CHAR_ZERO:
  306.       case CHAR_ONE:
  307.       case CHAR_TWO:
  308.       case CHAR_THREE:
  309.       case CHAR_FOUR:
  310.       case CHAR_FIVE:
  311.       case CHAR_SIX:
  312.       case CHAR_SEVEN:
  313.     *num=steps=0;
  314.     for(scr->text++;steps++<3 && isodigit(*scr->text);)
  315.       *num=*num*8+ *scr->text++ - CHAR_ZERO;
  316.     steps=0;
  317.     break;
  318.       case CHAR_NEWLINE:
  319.     /* After a line continuation backslash, a newline is required!
  320.        This is made to apply to the ANSI C escape sequence standard.
  321.        (added 930113-1305 / DaSt) */
  322.     cont=TRUE;
  323.     scr->virprg++;
  324.     break;
  325.       default:
  326.     /* Any character not identified as a escape sequence character
  327.        will simply ignore the backslah character!
  328.        (added 930113-1307 / DaSt) */
  329.     *num=scr->text[1];
  330.     break;
  331.       }
  332.       scr->text+=steps;
  333.     } else if(!string && *scr->text=='\n') {
  334.       /* This won't occur if the script is preprocessed! */
  335.       cont=TRUE;
  336.       scr->text++;
  337.     } else if(*scr->text=='\0') {
  338.       /* This won't occur if the script is preprocessed! */
  339.       cont=TRUE;
  340.       CALL(Newline(scr));
  341.     } else {
  342.       *num=*scr->text;
  343.       scr->text++;
  344.     }
  345.   }
  346.   return(ret);
  347. }
  348.  
  349. /**********************************************************************
  350.  *
  351.  * ReturnCode NewMember(struct Expr **);
  352.  *
  353.  * This function adds a new member in the linked list which keeps
  354.  * track on every operand and it's opertor in the expression.
  355.  *
  356.  *******/
  357.  
  358. ReturnCode REGARGS
  359. NewMember(struct Data *scr,
  360.           struct Expr **expr)
  361. {
  362.   GETMEM((*expr)->next, sizeof(struct Expr));
  363.  
  364.   (*expr)=(*expr)->next;
  365.   (*expr)->val.val=0;
  366.   (*expr)->unary=NULL;
  367.   (*expr)->operator=OP_NOTHING;
  368.   (*expr)->flags=FPL_OPERAND;
  369.   (*expr)->next=NULL;
  370.   return(FPL_OK);
  371. }
  372.  
  373.  
  374. /**********************************************************************
  375.  *
  376.  * ReturnCode Warn();
  377.  *
  378.  * This routines calls the interface function to ask for permission to
  379.  * continue the execution, even though error(s) has/have been found in
  380.  * the interpreted program.
  381.  *
  382.  ******/
  383.  
  384. ReturnCode REGARGS
  385. Warn(struct Data *scr,
  386.      ReturnCode rtrn)
  387. {
  388.   struct fplArgument *pass;
  389.   struct fplMsg *msg;
  390.   ReturnCode ret;
  391.  
  392.   GETMEM(pass, sizeof(struct fplArgument));
  393.   pass->ID=FPL_WARNING;
  394.   pass->key=scr;
  395.   pass->argc=1;
  396.   pass->argv=(void **)&rtrn; /* first ->argv member holds the error/warning number! */
  397.  
  398.   ret=InterfaceCall(scr, pass, scr->function);
  399.  
  400.   FREE(pass);
  401.   GetMessage(scr, FPLMSG_CONFIRM, &msg);
  402.   if(msg) {
  403.     if(msg->message[0]) {
  404.       rtrn=ret;
  405.       scr->prog->warnings++;
  406.     }
  407.     DeleteMessage(scr, msg);
  408.   }
  409.   return(rtrn);
  410. }
  411.  
  412.  
  413. /**********************************************************************
  414.  *
  415.  * fplSend()
  416.  *
  417.  * Send a message to FPL.
  418.  *
  419.  ******/
  420.  
  421. ReturnCode PREFIX fplSend(AREG(0) struct Data *scr,
  422.               AREG(1) unsigned long *tags)
  423. {
  424. #ifdef DEBUGMAIL
  425.   DebugMail(scr, MAIL_FUNCTION, 500, "fplSend");
  426. #endif
  427.   return Send(scr, tags);
  428. }
  429.  
  430. ReturnCode REGARGS Send(struct Data *scr,
  431.             unsigned long *tags)
  432. {
  433.   struct fplMsg msg;
  434.   long len=-1;
  435.   struct Program *prog;
  436.   char *data=NULL;
  437.   ReturnCode ret;
  438.   struct fplSymbol *symbol;
  439.   struct fplStr *string;
  440.   long mixed;
  441.   static long *resultcode=NULL;
  442.   char fplallocstring=FALSE;
  443.   if(!scr)
  444.     return(FPLERR_ILLEGAL_ANCHOR);
  445.  
  446.   memset(&msg, 0, sizeof(struct fplMsg));
  447.  
  448.   while(tags && *tags) {
  449.     switch(*tags++) {
  450.  
  451.     case FPLSEND_STRING:
  452.       /* FPLSEND_PROGRAMFILE is the same tag */
  453.       data=(void *)*tags;
  454.       msg.type=FPLMSG_RETURN_STRING;
  455.       break;
  456.  
  457.     case FPLSEND_STRLEN:
  458.       len=(long)*tags;
  459.       break;
  460.  
  461.     case FPLSEND_DONTCOPY_STRING: /* the string sent is fplAllocString()'ed */
  462.       fplallocstring=(char)*tags;
  463.       break;
  464.  
  465.     case FPLSEND_INT:
  466.       msg.message[0]=(void *)*tags;
  467.       msg.type=FPLMSG_RETURN_INT;
  468.       break;
  469.  
  470.     case FPLSEND_PROGRAM:
  471.       msg.message[0]=(void *)*tags;
  472.       msg.type=FPLMSG_PROGRAM;
  473.       break;
  474.  
  475.     case FPLSEND_CONFIRM:
  476.       msg.type=FPLMSG_CONFIRM;
  477.       msg.message[0]=(void *)*tags;
  478.       break;
  479.  
  480.     case FPLSEND_GETINTERVAL:
  481.       *(long *)*tags=(long)scr->interfunc;
  482.       break;
  483.  
  484.     case FPLSEND_GETFUNCTION:
  485.       *(long *)*tags=(long)scr->function;
  486.       break;
  487.  
  488.     case FPLSEND_GETLINE:
  489.       *(long *)*tags=scr->prg;
  490.       break;
  491.  
  492.     case FPLSEND_GETVIRFILE:
  493.       *(char **)*tags=scr->virfile;
  494.       break;
  495.  
  496.     case FPLSEND_GETVIRLINE:
  497.       *(long *)*tags=scr->virprg;
  498.       break;
  499.  
  500.     case FPLSEND_GETNEWLINE_HOOK:        /* OBSOLETE!!!! */
  501.       break;
  502.  
  503.     case FPLSEND_GETRESULT:
  504.       *(long *)*tags=scr->data;
  505.       break;
  506.  
  507.     case FPLSEND_GETRETURNCODE:
  508.       *(long *)*tags=scr->FPLret;
  509.       break;
  510.  
  511.     case FPLSEND_GETRETURNINT: /* new from V10 */
  512.       *(long **)*tags=scr->returnint;
  513.       break;
  514.  
  515.     case FPLSEND_GETUSERDATA:
  516.       *(long *)*tags=(long)scr->userdata;
  517.       break;
  518.  
  519.     case FPLSEND_GETCOLUMN:
  520.       if(scr->prog && scr->prog->running)
  521.     *(long *)*tags=(scr->text-(&scr->prog->program)[scr->prg-1]+1);
  522.       else if(scr->prog)
  523.     /* we cannot count on this programs presence */
  524.     *(long *)*tags=scr->prog->column;
  525.       else
  526.     *(long *)*tags=0; /* we don't know! */
  527.       break;
  528.  
  529.     case FPLSEND_GETPROGNAME:
  530.       if(scr->prog && scr->prog->name)
  531.     *(char **)*tags=scr->prog->name;
  532.       else /* we have no program information */
  533.     *(char **)*tags=FPLTEXT_UNKNOWN_PROGRAM;
  534.       break;
  535.  
  536.     case FPLSEND_GETPROG:
  537.       if(scr->prog && scr->prog->program)
  538.     *(char **)*tags=scr->prog->program;
  539.       else /* we have no program information */
  540.     *(char **)*tags=NULL;
  541.       break;
  542.  
  543.     case FPLSEND_FLUSHCACHE:
  544.       if(*tags)
  545.     FlushFree(scr);
  546.       break;
  547.  
  548.     case FPLSEND_FLUSHFILE:
  549.       if(*tags) {
  550.     prog=scr->programs;
  551.     while(prog) {
  552.       if(!strcmp(prog->name, (char *)*tags))
  553.         break;
  554.       prog=prog->next;
  555.     }
  556.     if(!prog)
  557.       return(FPLERR_INTERNAL_ERROR);
  558.       } else
  559.     prog=scr->programs;
  560.       while(prog) {
  561.     if(!(prog->running)) {
  562.       /* if the program isn't running right now! */
  563.       len=prog->flags;
  564.       prog->flags&=~PR_CACHEFILE; /* switch off the cache bit now */
  565.       CALL(LeaveProgram(scr, prog));
  566.       prog->flags=len; /* restore flag bits! */
  567.     }
  568.     if(*tags)
  569.       /* only the specified */
  570.       break;
  571.     prog=prog->next;
  572.       }
  573.       break;
  574.  
  575.     case FPLSEND_FREEFILE:
  576.       prog=scr->programs;
  577.       while(prog) {
  578.     if(!strcmp(prog->name, (char *)*tags))
  579.       break;
  580.     prog=prog->next;
  581.       }
  582.       if(!prog || prog->running || prog->openings)
  583.     /* if not found or if the found one is currently in use! */
  584.     return(FPLERR_ILLEGAL_PARAMETER);
  585.       {
  586.         for(mixed=0; mixed<scr->hash_size; mixed++) {
  587.           register struct Identifier *nident;
  588.           register struct Identifier *ident = scr->hash[mixed];
  589.           while(ident) {
  590.             nident=ident->next;
  591.             if(!strcmp(ident->file, (char *)*tags))
  592.               DelIdentifier(scr, NULL, ident);
  593.             ident=nident;
  594.           }
  595.         }
  596.       }
  597.       DelProgram(scr, prog);
  598.       break;
  599.  
  600.     case FPLSEND_STEP:
  601.       if(*tags>0) {
  602.     while((*tags)--) {
  603.       if(!*scr->text)
  604.         CALL(Newline(scr));
  605.       scr->text++;
  606.     }
  607.       } else if((signed int)(*tags)<0) {
  608.     while((*tags)++) {
  609.       if( (scr->text-(&scr->prog->program)[scr->prg-1])>=0)
  610.         scr->text--;
  611.       else
  612.         if(scr->prg>1)
  613.           scr->text=(&scr->prog->program)[--scr->prg-1];
  614.         else
  615.           return(FPLERR_UNEXPECTED_END);
  616.     }
  617.       }
  618.       break;
  619.     case FPLSEND_GETSYMBOL_FUNCTIONS:
  620.       CALL(GetSymbols(scr, FPL_EXTERNAL_FUNCTION|FPL_INSIDE_FUNCTION,
  621.               FPL_EXPORT_SYMBOL,
  622.               (struct fplSymbol **)*tags));
  623.       break;
  624.     case FPLSEND_GETSYMBOL_MYFUNCTIONS:
  625.       CALL(GetSymbols(scr, FPL_EXTERNAL_FUNCTION, FPL_FUNCTION,
  626.               (struct fplSymbol **)*tags));
  627.       break;
  628.     case FPLSEND_GETSYMBOL_FPLFUNCTIONS:
  629.       CALL(GetSymbols(scr, FPL_EXPORT_SYMBOL, FPL_INSIDE_FUNCTION,
  630.               (struct fplSymbol **)*tags));
  631.       break;
  632.     case FPLSEND_GETSYMBOL_VARIABLES:
  633.       CALL(GetSymbols(scr, FPL_EXPORT_SYMBOL, FPL_VARIABLE,
  634.               (struct fplSymbol **)*tags));
  635.       break;
  636.     case FPLSEND_GETSYMBOL_ALLVARIABLES:
  637.       CALL(GetSymbols(scr, ~0, FPL_VARIABLE, (struct fplSymbol **)*tags));
  638.       break;
  639.  
  640.     case FPLSEND_GETSYMBOL_ALLFUNCTIONS:
  641.       CALL(GetSymbols(scr, ~0, FPL_FUNCTION, (struct fplSymbol **)*tags));
  642.       break;
  643.  
  644.     case FPLSEND_GETSYMBOL_CACHEDFILES:
  645.       prog=scr->programs;
  646.       mixed=0;
  647.       while(prog) {
  648.     if(prog->flags&PR_CACHEFILE)
  649.       mixed++;
  650.     prog=prog->next;
  651.       }
  652.  
  653.       GETMEM(symbol, sizeof(struct fplSymbol));
  654.       symbol->num=mixed;
  655.       GETMEM(symbol->array, mixed*sizeof(char *));
  656.  
  657.       mixed=0;
  658.       prog=scr->programs;
  659.       while(prog) {
  660.     if(prog->flags&PR_CACHEFILE)
  661.       symbol->array[mixed++]=prog->name;
  662.     prog=prog->next;
  663.       }
  664.       *(struct fplSymbol **)*tags=symbol;
  665.  
  666. #ifdef DEBUG
  667.       CheckMem(scr, symbol);
  668.       CheckMem(scr, symbol->array);
  669. #endif
  670.  
  671.       break;
  672.  
  673.       /* ----------------  new from V10: --------------------- */
  674.  
  675.     case FPLSEND_RESULT:
  676.       resultcode = (long *)(*tags); /* long to store result in! */
  677.       break;
  678.  
  679.     case FPLSEND_IS_FILE_CACHED:
  680.       if(resultcode) {
  681.         prog=scr->programs;
  682.         while(prog) {
  683.           if(prog->name && !strcmp(prog->name, (char *)(*tags))) {
  684.             *resultcode = TRUE;
  685.             break;
  686.           }
  687.           prog=prog->next;
  688.         }
  689.         *resultcode = FALSE;
  690.       }
  691.       break;
  692.     
  693.       /* --------------------------------------------------- */
  694.  
  695.     case FPLSEND_GETSYMBOL_FREE:
  696. #ifdef DEBUG
  697.       CheckMem(scr, (void *)(*tags));
  698.       CheckMem(scr, ((struct fplSymbol *)*tags)->array);
  699. #endif
  700.       FREE(((struct fplSymbol *)*tags)->array);
  701.       FREE(*tags);
  702.       break;
  703.  
  704. #if defined(AMIGA) && defined(SHARED)
  705.     case FPLSEND_GETSTACKSIZE:
  706.       *(long *)*tags=scr->stack_size;
  707.       break;
  708.     case FPLSEND_GETSTACKUSED:
  709.       *(long *)*tags=GetStackUsed(scr);
  710.       break;
  711. #endif
  712.  
  713.     case FPLSEND_SETPROGNAME:
  714.       if(scr->prog) {
  715.     if(scr->prog->name)
  716.       FREEA(scr->prog->name);
  717.     STRDUPA(scr->prog->name, *tags);
  718.       }
  719.       break;
  720.  
  721.     case FPLSEND_SETFILENAMEGET:
  722.       if(scr->prog) {
  723.     if(*tags)
  724.       scr->prog->flags|=PR_FILENAMEFLUSH;
  725.     else
  726.       scr->prog->flags&=~PR_FILENAMEFLUSH;
  727.       }
  728.       break;
  729.     }
  730.     tags++;
  731.   }
  732.   if(!msg.type)
  733.     /*
  734.      * There is no message to send. Everything we had to do is done!
  735.      */
  736.     return(FPL_OK);
  737.  
  738.   if(msg.type==FPLMSG_RETURN_STRING) {
  739.     if(len<0)
  740.       if(data)
  741.     len=strlen(data);
  742.     if(!len || !data)
  743.       /* this really is a zero length string! */
  744.       msg.message[0]=NULL;
  745.     else {
  746.       if(!fplallocstring) {
  747.         /* we have to duplicate the data */
  748.         GETMEM(msg.message[0], len+sizeof(struct fplStr));
  749.         string=msg.message[0];
  750.         string->len=len;
  751.         string->alloc=len;
  752.         memcpy(string->string, data, len); /* copy string! */
  753.         string->string[string->len]=CHAR_ASCII_ZERO; /* zero terminate */
  754.       } else {
  755.         /* the data was sent as fplAllocString() data! */
  756.         string= (struct fplStr *)(data - offsetof(struct fplStr, string));
  757.         string->len=len;
  758.         string->string[string->len]=CHAR_ASCII_ZERO; /* zero terminate */
  759.         SwapMem(scr, string, MALLOC_DYNAMIC); /* convert */
  760.         msg.message[0]=string;
  761.       }
  762.     }
  763.   }
  764.   CALL(SendMessage(scr, &msg));
  765.   return(ret);
  766. }
  767.  
  768.  
  769. /*********************************************************************
  770.  *
  771.  * fplConvertString()
  772.  *
  773.  * Returns the number of characters converted from the FPL format
  774.  * string to the binary sting stored in a buffer.
  775.  *
  776.  * The output string always get zero terminated!
  777.  *
  778.  *****/
  779.  
  780. long PREFIX
  781. fplConvertString(AREG(0) struct Data *scr,
  782.                  AREG(1) char *string,
  783.                  AREG(2) char *buffer)
  784. {
  785.   long prg=scr->prg;
  786.   char *text=scr->text;
  787.   long line;
  788.   char *base;
  789.   long a;
  790.   long number=0;
  791.  
  792. #ifdef DEBUGMAIL
  793.   DebugMail(scr, MAIL_FUNCTION, 500, "fplConvertString");
  794. #endif
  795.  
  796.   if(!scr->prog) {
  797.     /*
  798.      * There is no program at the moment!
  799.      * create a pseudo program for now!
  800.      */
  801.     scr->prog=(struct Program *)MALLOC(sizeof(struct Program));
  802.     if(!scr->prog)
  803.       return(0); /* no characters in output! */
  804.     scr->prog->flags|=PR_TEMPORARY;
  805.   }
  806.   
  807.   base=scr->prog->name;
  808.   line=scr->prog->lines;
  809. /*
  810.   if(*string==CHAR_QUOTATION_MARK)
  811.     string++;
  812. */
  813.  
  814.   scr->prg=1;
  815.   scr->text=string;
  816.   scr->prog->lines=1;
  817.   scr->prog->name=NULL; /* we have no file ID yet! */
  818.  
  819.   while(/* *scr->text!=CHAR_QUOTATION_MARK && */
  820.     !ReturnChar(scr, &a, TRUE)) { /* returns non-zero when an ascii zero is
  821.                          found! */
  822.     *buffer++=a;
  823.     number++;
  824.   }
  825.   
  826.   *buffer=CHAR_ASCII_ZERO;
  827.  
  828.   scr->prg=prg;
  829.   scr->text=text;
  830.   scr->prog->lines=line;
  831.   scr->prog->name=base;
  832.   
  833.   if(scr->prog->flags&PR_TEMPORARY) {
  834.     FREE(scr->prog);
  835.     scr->prog=NULL;
  836.   }
  837.  
  838.   return(number);
  839. }
  840.  
  841. /**********************************************************************
  842.  *
  843.  * GetSymbols();
  844.  *
  845.  * Allocates a structure and data, which is a list of name pointers
  846.  * that match the flag parameter.
  847.  *
  848.  *******/
  849.  
  850. static ReturnCode REGARGS
  851. GetSymbols(struct Data *scr,
  852.            long flag1,
  853.            long flag2,
  854.            struct fplSymbol **get)
  855. {
  856.   long i;
  857.   long num;
  858.   struct Identifier *ident;
  859.   struct fplSymbol *symbol;
  860.  
  861.   for(i=num=0; i<FPL_HASH_SIZE; i++) {
  862.     ident=scr->hash[i];
  863.     while(ident) {
  864.       if(ident->flags&flag1 && ident->flags&flag2)
  865.     num++;
  866.       ident=ident->next;
  867.     }
  868.   }
  869.  
  870.   GETMEM(symbol, sizeof(struct fplSymbol));
  871.   symbol->num=num;
  872.  
  873.   GETMEM(symbol->array, sizeof(char *)*symbol->num);
  874.  
  875.   for(i=num=0; i<FPL_HASH_SIZE; i++) {
  876.     ident=scr->hash[i];
  877.     while(ident) {
  878.       if(ident->flags&flag1 && ident->flags&flag2)
  879.     symbol->array[num++]=ident->name;
  880.       ident=ident->next;
  881.     }
  882.   }
  883.   *get=symbol;
  884.  
  885. #ifdef DEBUG
  886.   CheckMem(scr, symbol->array);
  887. #endif
  888.   return(FPL_OK);
  889. }
  890.  
  891.  
  892. /**********************************************************************
  893.  *
  894.  * SendMessage();
  895.  *
  896.  * Add a member to the message queue. Allocate a new struct and copy the
  897.  * data of from second parameter message pointer.
  898.  *
  899.  ******/
  900.  
  901. static ReturnCode INLINE
  902. SendMessage(struct Data *scr,
  903.             struct fplMsg *msg)
  904. {
  905.   struct fplMsg *NewMsg, *ptr;
  906.  
  907.   GETMEM(NewMsg, sizeof(struct fplMsg));
  908.  
  909.   *NewMsg=*msg; /* copy all data from source */
  910.  
  911.   /* Queue the message: */
  912.   if(ptr=scr->msg)
  913.     ptr->prev=NewMsg; /* this message becomes the previous for this */
  914.  
  915.   scr->msg=NewMsg;
  916.   NewMsg->next=ptr;
  917.   NewMsg->prev=NULL; /* no previous, this is first! */
  918.  
  919.   return(FPL_OK);
  920. }
  921.  
  922. /**********************************************************************
  923.  *
  924.  * DeleteMessage();
  925.  *
  926.  * Deletes specified or current message (NULL).
  927.  *
  928.  *****/
  929.  
  930. ReturnCode REGARGS
  931. DeleteMessage(struct Data *scr,
  932.               struct fplMsg *msg)
  933. {
  934.   struct fplMsg *ptr=scr->msg;
  935.   if(msg) 
  936.     ptr=msg;
  937.   if(ptr) {
  938.     if(ptr->next)
  939.       ptr->next->prev=ptr->prev; /* redirect next message's prev pointer */
  940.     else if(!ptr->prev) /* is this the only message? */
  941.       scr->msg=NULL;
  942.     if(ptr->prev)
  943.       ptr->prev->next=ptr->next; /* redirect previous message's next pointer */
  944.     FREE(ptr);  /* free message */
  945.   }
  946.   return(FPL_OK);
  947. }
  948.  
  949. /**********************************************************************
  950.  *
  951.  * GetMessage()
  952.  *
  953.  * Returns the first message of the requested type in the pointer
  954.  * in the third argument!
  955.  *
  956.  ****/
  957.  
  958. ReturnCode REGARGS
  959. GetMessage(struct Data *scr,
  960.            char type,
  961.            struct fplMsg **get)
  962. {
  963.   struct fplMsg *msg=scr->msg;
  964.   while(*get=msg) {
  965.     if(msg->type==type)
  966.       break;
  967.     msg=msg->next;
  968.   }
  969.   return(FPL_OK);
  970. }
  971.  
  972. /**********************************************************************
  973.  *
  974.  * GetProgram();
  975.  *
  976.  * Whenever we want to access a program in the program list, we do it
  977.  * using this function. This enables heavy program swapping capabilities.
  978.  * Programs that are not being used can be flushed from memory and brought
  979.  * back whenever we need it!
  980.  *
  981.  ******/
  982.  
  983. ReturnCode REGARGS
  984. GetProgram(struct Data *scr,
  985.            struct Program *prog)
  986. {
  987.   struct fplArgument *arg;
  988.   ReturnCode ret;
  989.   struct fplMsg *msg;
  990.   struct fplStr *string;
  991.   if(!prog->program) {
  992.     /*
  993.      * The program is not currently in memory. Get it!
  994.      */
  995.     
  996.     if(prog->flags&PR_FILENAMEFLUSH) {
  997.       /*
  998.        * We know that the program is simply to load from the file the program
  999.        * name specifies.
  1000.        */
  1001.       CALL(ReadFile(scr, prog->name, prog));
  1002.     } else {
  1003.       /*
  1004.        * We must ask user for information!
  1005.        */
  1006.       
  1007.       GETMEM(arg, sizeof(struct fplArgument));
  1008.       arg->ID=FPL_FILE_REQUEST;
  1009.       arg->key=(void *)scr;
  1010.       arg->argv=(void **)&prog->name;
  1011.       arg->argc=1;
  1012.       ret=InterfaceCall(scr, arg, scr->function);
  1013.       FREE(arg);
  1014.       if(ret)
  1015.         return ret;
  1016.       
  1017.       GetMessage(scr, FPLMSG_PROGRAM, &msg);
  1018.       if(!msg) {
  1019.     GetMessage(scr, FPLMSG_RETURN_STRING, &msg);
  1020.     if(!msg)
  1021.       /*
  1022.        * No kind of proper answer could be found!
  1023.        * Dead end failure!
  1024.        */      
  1025.       return(FPLERR_INTERNAL_ERROR);
  1026.     
  1027.     string=(struct fplStr *)msg->message[0];
  1028.     ret = ReadFile(scr, string->string, prog);
  1029.     FREE(msg->message[0]); /* we don't need this anymore! */
  1030.     if(ret)
  1031.       return ret;
  1032.       } else {
  1033.     /*
  1034.      * User supplied us with a memory pointer to the program again!
  1035.      */
  1036.     prog->program= (char *)msg->message[0];
  1037.     prog->flags|=PR_USERSUPPLIED;
  1038.       }
  1039.       DeleteMessage(scr, msg);
  1040.     }
  1041.   } /* else
  1042.        we already have it loaded! */
  1043.   prog->running++;
  1044.   return(FPL_OK);
  1045. }
  1046.  
  1047.  
  1048. /**********************************************************************
  1049.  *
  1050.  * LeaveProgram();
  1051.  *
  1052.  * If we leave one program, call this. If any flush is to be done, this
  1053.  * will perform that!
  1054.  *
  1055.  ******/
  1056.  
  1057. ReturnCode REGARGS
  1058. LeaveProgram(struct Data *scr,
  1059.              struct Program *prog)
  1060. {
  1061.   struct fplArgument *arg;
  1062.   ReturnCode ret;
  1063.   struct fplMsg *msg;
  1064.   prog->running--;
  1065.   if(prog->program && !prog->running && prog->flags&PR_FLUSH_NOT_IN_USE) {
  1066.     /*
  1067.      * The program is there and no one is using it!
  1068.      * flush it if we want to!
  1069.      */
  1070.  
  1071.     if(prog->flags&PR_USERSUPPLIED) {
  1072.       /*
  1073.        * This program is supplied by the external program. We cannot
  1074.        * free the memory, only tell our father that freeing is OK...
  1075.        */
  1076.       GETMEM(arg, sizeof(struct fplArgument));
  1077.       arg->ID=FPL_FLUSH_FILE;
  1078.       arg->key=(void *)scr;
  1079.       arg->argv=(void **)&prog->name;
  1080.       arg->argc=1;
  1081.       CALL(InterfaceCall(scr, arg, scr->function));
  1082.       FREE(arg);
  1083.       GetMessage(scr, FPLMSG_CONFIRM, &msg);
  1084.       /*
  1085.        * We require a {FPLSEND_CONFIRM, TRUE} message from the user before we
  1086.        * flush the user supplied function! Simply ignore implementing any
  1087.        * answer to this message if we never want to flush user supplied
  1088.        * functions.
  1089.        */
  1090.       if(msg && msg->message[0])
  1091.     /* If we got a "OK" message! */
  1092.     prog->program=NULL;
  1093.       if(msg)
  1094.     DeleteMessage(scr, msg);
  1095.     } else {
  1096.       /*
  1097.        * The memory occupied by this program is our business.
  1098.        * Swap the memory first to be sure we know the kind of it!
  1099.        */
  1100.       SwapMem(scr, prog->program, MALLOC_DYNAMIC);
  1101.       FREE(prog->program);
  1102.       prog->program=NULL; /* to visualize the clearing of this program! */
  1103.     }
  1104.   }
  1105.   return(FPL_OK);
  1106. }
  1107.  
  1108. /**********************************************************************
  1109.  *
  1110.  * int functions(struct fplArgument *);
  1111.  *
  1112.  * This function handles the internal functions. *EXACTLY* the same way
  1113.  * external processes handles their functions!!! :-)
  1114.  *
  1115.  *****/
  1116.  
  1117. ReturnCode REGARGS
  1118. functions(struct fplArgument *arg)
  1119. {
  1120.   struct Expr *val;
  1121.   unsigned long inttags[]={FPLSEND_INT, 0, FPLSEND_DONE};
  1122.   unsigned long strtags[]={FPLSEND_STRING, 0, FPLSEND_STRLEN, 0, FPLSEND_DONE};
  1123.   long base;
  1124.   ReturnCode ret;
  1125.   struct Data *scr=(struct Data *)arg->key;
  1126.   struct fplStr *string;
  1127.   long prg;
  1128.   long line;
  1129.   long virprg;
  1130.   char *virfile;
  1131.   char *text;
  1132. /*  char *file; */
  1133.   long len;        /* length of the string */
  1134.   register long col;    /* the column parameter */
  1135.   switch(arg->ID) {
  1136.     
  1137.   case FNC_ABS:
  1138.     inttags[1]= ABS((long)arg->argv[0]);
  1139.     CALL(Send(arg->key, inttags));
  1140.     break;
  1141.  
  1142.   case FNC_ITOC:
  1143.     prg=(long)arg->argv[0]&255;
  1144.     text=(char *)&line; /* we just need 2 bytes to play with in peace! */
  1145.     text[1]='\0';
  1146.     text[0]=prg;
  1147.     strtags[1]=(long)text;
  1148.     strtags[3]=1;
  1149.     CALL(Send(scr, strtags));
  1150.     break;
  1151.     
  1152.   case FNC_JOINSTR:
  1153.     string=NULL;
  1154.     for(prg=0; prg<arg->argc; prg++) {
  1155.       CALL(StrAssign((struct fplStr *) ((char *)arg->argv[prg]-
  1156.                     offsetof(struct fplStr, string)),
  1157.              scr, &string, TRUE));
  1158.     }
  1159.     if(string) {
  1160.       strtags[1]=(unsigned long)string->string;
  1161.       strtags[3]=string->len;
  1162.       CALL(Send(scr, strtags));
  1163.       FREE(string);
  1164.     }
  1165.     break;
  1166.  
  1167.   case FNC_ITOA:
  1168.   case FNC_LTOSTR:
  1169.     base=(arg->argc<2?10:(long)arg->argv[1]);
  1170.     CALL(Ltostr(scr, &string, base, (long)arg->argv[0]));
  1171.     strtags[1]=(unsigned long)string->string;
  1172.     strtags[3]=string->len;
  1173.     CALL(Send(scr, strtags));
  1174.     FREE(string);
  1175.     break;
  1176.     
  1177.   case FNC_ATOI:
  1178.   case FNC_STRTOL:
  1179.     base=(arg->argc<2?10:(long)arg->argv[1]);
  1180.     inttags[1]= Strtol((char *)arg->argv[0], base, &text);
  1181.     CALL(Send(scr, inttags));
  1182.     break;
  1183.     
  1184.   case FNC_EVAL:
  1185.     prg=scr->prg;
  1186.     text=scr->text;
  1187.     line=scr->prog->lines;
  1188.     virprg=scr->virprg;
  1189.     virfile=scr->virfile;
  1190.  
  1191.     scr->virprg=1;
  1192.     scr->virfile=NULL;
  1193.     scr->text=(char *)arg->argv[0];
  1194.     scr->prg=scr->prog->lines=1;
  1195.  
  1196.     GETMEM(val, sizeof(struct Expr));
  1197.     CALL(Expression(val, scr, CON_GROUNDLVL|CON_END|CON_NUM, NULL));
  1198.     inttags[1]=val->val.val;
  1199.     FREE(val);
  1200.  
  1201.     scr->prg=prg;
  1202.     scr->text=text;
  1203.     scr->prog->lines=line;
  1204.     scr->virprg=virprg;
  1205.     scr->virfile=virfile;
  1206.     
  1207.     CALL(Send(scr, inttags));
  1208.     break;
  1209.     
  1210.   case FNC_INTERPRET:
  1211.     prg=scr->prg;
  1212.     text=scr->text;
  1213.     line=scr->prog->lines;
  1214. /*    file=scr->prog->name; */
  1215.     virprg=scr->virprg;
  1216.     virfile=scr->virfile;
  1217.     scr->virprg=1;
  1218.     scr->virfile=NULL;
  1219.     scr->interpret=NULL; /* nothing recursive here, no no! */
  1220.     scr->prg=1;
  1221.     scr->text=(char *)arg->argv[0];
  1222.     scr->prog->lines=1;
  1223. /*    scr->prog->name=NULL; */ /* we have no file name! */
  1224.  
  1225.     GETMEM(val, sizeof(struct Expr));
  1226.     ret=Script(scr, val, SCR_NORMAL, NULL);
  1227.     inttags[1]=val->val.val;
  1228.     FREE(val);
  1229.  
  1230.     if(ret) {
  1231.       /*
  1232.        * Check if the error occurred somewhere in the real program
  1233.        * or if it was within the argument. If within argument, we
  1234.        * set back the previous program pointer, otherwise not.
  1235.        */
  1236.       for(base=0;base<line;base++)
  1237.     if(scr->text>(&scr->prog->program)[base] &&
  1238.        scr->text<((&scr->prog->program)[base]+
  1239.               strlen((&scr->prog->program)[base])))
  1240.       break;
  1241.       if(base==line) {
  1242.     scr->prg=prg;
  1243.     scr->text=text;
  1244.     scr->prog->lines=line;
  1245. /*    scr->prog->name=file; */
  1246.       }
  1247.       return(ret);
  1248.     }
  1249.     scr->prg=prg;
  1250.     scr->text=text;
  1251.     scr->prog->lines=line;
  1252. /*    scr->prog->name=file; */
  1253.     scr->virprg=virprg;
  1254.     scr->virfile=virfile;
  1255.     CALL(Send(arg->key, inttags));
  1256.     break;
  1257.     
  1258.   case FNC_STRCMP:
  1259.   case FNC_STRICMP:
  1260.     /*
  1261.      * strcmp() with strings that can include a zero byte must use
  1262.      * memcmp(), but that also takes a third length argument which
  1263.      * must never be larger than the smallest of the two compared
  1264.      * strings!
  1265.      */
  1266.     line = MIN(FPL_STRING_LENGTH(arg, 0), FPL_STRING_LENGTH(arg, 1)); /* len */
  1267.  
  1268.     if(FNC_STRCMP == arg->ID)
  1269.       base = memcmp(arg->argv[0], arg->argv[1], line);
  1270.     else
  1271.       base = my_memicmp(arg->argv[0], arg->argv[1], line);
  1272.  
  1273.     if(!base && FPL_STRING_LENGTH(arg, 0) != FPL_STRING_LENGTH(arg, 1)) {
  1274.       /* similar strings after 'line' characters */
  1275.  
  1276.       /*
  1277.        * The strings are of different length.
  1278.        */
  1279.  
  1280.       base = ((char *)arg->argv[0])[line] -
  1281.     (FPL_STRING_LENGTH(arg, 1)>line?
  1282.      ((char *)arg->argv[1])[line] : 0 );
  1283.       
  1284.       if(!base) {
  1285.     /* only possible since FPL strings can hold zeroes! */
  1286.     base = 256; /* not possible in regular C */
  1287.       }
  1288.     }
  1289.     inttags[1]=base;
  1290.     CALL(Send(scr, inttags));
  1291.     break;
  1292.     
  1293.   case FNC_SUBSTR:
  1294.     len=FPL_STRING_LENGTH(arg, 0);
  1295.     col=(long)arg->argv[1];
  1296.     if(col>len || col<0) {
  1297.       strtags[1]=(unsigned long)NULL;    /* we can't get any string! */
  1298.     } else {
  1299.       len-=col;            /* Maximum length we can get */
  1300.       strtags[3]=((long)arg->argv[2]>len?len:(long)arg->argv[2]); /* strlen */
  1301.       strtags[1]=(long) arg->argv[0]+col; /* return string from here */
  1302.     }
  1303.     CALL(Send(scr, strtags));
  1304.     break;
  1305.     
  1306.   case FNC_STRLEN:
  1307.     inttags[1]=FPL_STRING_LENGTH(arg, 0);
  1308.     CALL(Send(scr, inttags));
  1309.     break;
  1310.  
  1311.   case FNC_STRNCMP:
  1312.   case FNC_STRNICMP:
  1313.     /*
  1314.      * strncmp() with strings that can include a zero byte must use
  1315.      * memcmp(), that also takes a third length argument which
  1316.      * must never be larger than the smallest of the two compared
  1317.      * strings or the number specified!
  1318.      */
  1319.     if(FNC_STRNCMP == arg->ID) {
  1320.       inttags[1]=
  1321.     memcmp(arg->argv[0], arg->argv[1],
  1322.            MIN3((long)arg->argv[2],
  1323.             FPL_STRING_LENGTH(arg, 0), FPL_STRING_LENGTH(arg, 1)));
  1324.     }
  1325.     else {
  1326.       inttags[1]=
  1327.     my_memicmp(arg->argv[0], arg->argv[1],
  1328.         MIN3((long)arg->argv[2],
  1329.              FPL_STRING_LENGTH(arg, 0), FPL_STRING_LENGTH(arg, 1)));
  1330.     }
  1331.     CALL(Send(scr, inttags));
  1332.     break;
  1333.     
  1334.   case FNC_STRSTR:
  1335.   case FNC_STRISTR:
  1336.     /*
  1337.      * strstr() should compare two memory regions, like a memmem()!
  1338.      * Code an own!
  1339.      */
  1340.     base = FPL_STRLEN(arg->argv[0]);
  1341.     line = FPL_STRLEN(arg->argv[1]);
  1342.     text = (char *)arg->argv[0];
  1343.  
  1344.     /*
  1345.      * Addition from FPL version 9:
  1346.      * starting search column in third parameter!
  1347.      */
  1348.     if(arg->argc>2) {
  1349.       if((int)arg->argv[2] < base) {
  1350.     text+=(int)arg->argv[2];
  1351.     base-=(int)arg->argv[2];
  1352.       }
  1353.       else {
  1354.     /* tried to start searching outside the string! */
  1355.  
  1356.     line = 1; /* to make a not-found return code */
  1357.     base = 0;
  1358.       }
  1359.     }
  1360.     
  1361.     if(line && base) {
  1362.       if(FNC_STRSTR == arg->ID) {
  1363.     /* Case sensitive */
  1364.     while(base-->=line) {
  1365.       if(!memcmp(text, (char *)arg->argv[1], line)) {
  1366.         line=0;
  1367.         break;
  1368.       }
  1369.       text++;
  1370.     }
  1371.       }
  1372.       else {
  1373.     /* Case insensitive */
  1374.     while(base-->=line) {
  1375.       if(!my_memicmp(text, (char *)arg->argv[1], line)) {
  1376.         line=0;
  1377.         break;
  1378.       }
  1379.       text++;
  1380.     }
  1381.       }
  1382.     }
  1383.     inttags[1]=line?-1:text-(char *)arg->argv[0];
  1384.  
  1385.     /* OLD ONE:
  1386.     text=(char *)strstr((char *)arg->argv[0], (char *)arg->argv[1]);
  1387.     inttags[1]=text?text-(char *)arg->argv[0]:-1;
  1388.     */
  1389.     CALL(Send(scr, inttags));
  1390.     break;
  1391.  
  1392.   case FNC_SPRINTF:
  1393.     {
  1394.         static unsigned long tags[]={
  1395.             FPLSEND_STRING, 0,
  1396.             FPLSEND_STRLEN, 0,
  1397.             FPLSEND_DONTCOPY_STRING, TRUE,
  1398.             FPLSEND_DONE
  1399.         };
  1400.         string = NULL;
  1401.         CALL(Sprintf(scr, &string, arg->argv[0], arg->argv, arg->format));
  1402.         tags[1] = (long)string->string;
  1403.         tags[3] = string->len;
  1404.         CALL(Send(scr, tags));
  1405.     }
  1406.     break;
  1407.  
  1408. #if defined(AMIGA)
  1409.   case FNC_OPENLIB:
  1410.     CALL(OpenLib(scr,
  1411.                  (char *)arg->argv[0], /* name */
  1412.                  (long)arg->argv[1],   /* version */
  1413.                  (long *)&inttags[1],  /* funclib result */
  1414.                  0));                  /* normal 'soft' open */
  1415.     CALL(Send(scr, inttags));
  1416.     break;
  1417.  
  1418.   case FNC_CLOSELIB:
  1419.     CALL(CloseLib(scr,
  1420.                   (char *)arg->argv[0],  /* name */
  1421.                   0,                     /* 'soft' close */
  1422.                   (long *)&inttags[1])); /* funclib result */
  1423.     CALL(Send(scr, inttags));
  1424.     break;
  1425.  
  1426.   case FNC_DEBUG:
  1427.     if(arg->argc) {
  1428.       if(!(int)arg->argv[0]) {
  1429.         scr->flags&=~FPLDATA_DEBUG_MODE; /* switch off debug mode */
  1430. #ifdef DEBUGMAIL
  1431. /*        DebugMail(scr, MAIL_EXIT, 500, NULL); */
  1432. #endif
  1433.       }
  1434.       else {
  1435.         scr->flags|=FPLDATA_DEBUG_MODE;  /* switch on debug mode */
  1436. #ifdef DEBUGMAIL
  1437. /*        DebugMail(scr, MAIL_START, 500, NULL); */
  1438. #endif
  1439.       }
  1440.     }
  1441.     else {
  1442.        inttags[1]=scr->flags&FPLDATA_DEBUG_MODE?1:0; /* return status */
  1443.        CALL(Send(scr, inttags));
  1444.     }
  1445.     break;
  1446. #endif
  1447.   }
  1448.   return(FPL_OK);
  1449. }
  1450.  
  1451. #if defined(AMIGA)
  1452. ReturnCode REGARGS
  1453. OpenLib(struct Data *scr,
  1454.         char *lib,        /* funclib name */
  1455.         long version,     /* funclib version */
  1456.         long *retvalue,   /* funclib return code */
  1457.         char flags)
  1458. {
  1459.    struct MyLibrary *library;
  1460.    struct Library *DOSBase;
  1461.    BPTR seglist;
  1462.    char *command;
  1463.    char *cmd;
  1464.    struct FuncList *namelist=scr->funclibs;
  1465.    char *name;
  1466.    ReturnCode ret;
  1467.    struct fplStr *string;
  1468.  
  1469.    struct ExecBase *SysBase = *(struct ExecBase **)4;
  1470.  
  1471.    library = (struct MyLibrary *)getreg(REG_A6);
  1472.    DOSBase = library->ml_DosBase;
  1473.  
  1474.    GETMEM(command, FPLLIB_MAXSPACE);
  1475.  
  1476.    while(namelist) {
  1477.      if(!strcmp(namelist->name, lib)) {
  1478.        namelist->opens++;
  1479.        return FPL_OK; /* this funclib is already opened */
  1480.      }
  1481.      namelist = namelist->next;
  1482.    }
  1483.  
  1484.    cmd = command;
  1485.    strcpy(command, FPLLIB_SOURCE);
  1486.    strcpy(command+strlen(FPLLIB_SOURCE), lib);
  1487.    seglist = LoadSeg(command); /* load the command! */
  1488.    if(seglist) {
  1489.      strcpy(command, FPLLIB_OPENCMD);
  1490.      command += strlen(FPLLIB_OPENCMD);
  1491.  
  1492.      CALL(Ltostr(scr, &string, 10, (long)scr));
  1493.      strcpy(command, string->string);
  1494.      command[string->len]= ' '; /* pad with a single space */
  1495.      command+=string->len+1;
  1496.      FREE(string);
  1497.  
  1498.      CALL(Ltostr(scr, &string, 10, version));
  1499.      strcpy(command, string->string);
  1500.      command[string->len]= '\n';   /* add newline */
  1501.      command[string->len+1]= '\0'; /* zero terminate */
  1502.      FREE(string);
  1503.  
  1504.      if(SysBase->SoftVer<36) {
  1505.        /* V33 solution! */
  1506.        char *segment = BADDR(seglist);
  1507.        int (*func)();
  1508. #pragma msg 147 ignore
  1509.        func = segment + 4; /* generates warning */
  1510. #pragma msg 147 warning
  1511.  
  1512.        putreg(REG_A0, (long)cmd);
  1513.        putreg(REG_D0, strlen(cmd));
  1514. #pragma msg 154 ignore
  1515.        *retvalue = (func)(); /* generates warning */
  1516. #pragma msg 154 warning
  1517.      } else /* version 36 or up! */
  1518.        *retvalue = RunCommand(seglist, 4000, cmd, strlen(cmd));
  1519.  
  1520.      UnLoadSeg( seglist );
  1521.    } else {
  1522.      /* we failed loading the command! */
  1523.      *retvalue = FUNCLIB_LOAD;
  1524.    }
  1525.  
  1526.    FREE(cmd);
  1527.  
  1528.    if(!*retvalue) {
  1529.       GETMEMA(namelist, sizeof(struct FuncList));
  1530.       STRDUPA(name, lib);
  1531.       namelist->name = name;
  1532.       namelist->opens = 1;
  1533.       namelist->flags = flags;
  1534.       namelist->next = scr->funclibs;
  1535.       scr->funclibs = namelist;
  1536.    }
  1537.    return FPL_OK;
  1538. }
  1539.  
  1540. ReturnCode REGARGS
  1541. CloseLib(struct Data *scr,
  1542.          char *lib,        /* funclib name or NULL for all */
  1543.          long flags,       /* options */
  1544.          long *retvalue)   /* funclib return code */
  1545. {
  1546.    struct MyLibrary *library;
  1547.    struct Library *DOSBase;
  1548.    struct FuncList *namelist=scr->funclibs;
  1549.    struct FuncList *prevlist=NULL;
  1550.    struct FuncList *next;
  1551.    char *command;
  1552.    char *cmd;
  1553.    ReturnCode ret;
  1554.    struct fplStr *string;
  1555.    BPTR seglist;
  1556.  
  1557.    struct ExecBase *SysBase = *(struct ExecBase **)4;
  1558.  
  1559.    library = (struct MyLibrary *)getreg(REG_A6);
  1560.    DOSBase = library->ml_DosBase;
  1561.  
  1562.    GETMEM(command, FPLLIB_MAXSPACE);
  1563.    cmd = command;
  1564.  
  1565.    while(namelist) {
  1566.      if(namelist->flags&FPLLIB_KEEP && namelist->opens==1) {
  1567.        /* This funclib is prevented from being 'soft' closed! */
  1568.        namelist->opens++;
  1569.      }
  1570.      if((!lib || !strcmp(namelist->name, lib)) &&
  1571.         (!--namelist->opens || flags&FPLLIB_FORCE) ) {
  1572.        /* the funclib _is_ opened! */
  1573.  
  1574.        strcpy(command, FPLLIB_SOURCE);
  1575.        strcpy(command+strlen(FPLLIB_SOURCE), lib);
  1576.        seglist = LoadSeg(command); /* load the command! */
  1577.        if(seglist) {
  1578.          strcpy(command, FPLLIB_CLOSECMD);
  1579.          command += strlen(FPLLIB_CLOSECMD);
  1580.     
  1581.          CALL(Ltostr(scr, &string, 10, (long)scr));
  1582.          strcpy(command, string->string);
  1583.          command[string->len]= '\n';   /* add newline */
  1584.          command[string->len+1]= '\0'; /* zero terminate */
  1585.          FREE(string);
  1586.     
  1587.          if(SysBase->SoftVer<36) {
  1588.            /* V33 solution! */
  1589.            char *segment = BADDR(seglist);
  1590.            int (*func)();
  1591. #pragma msg 147 ignore
  1592.            func = segment + 4; /* generates warning */
  1593. #pragma msg 147 warning
  1594.     
  1595.            putreg(REG_A0, (long)cmd);
  1596.            putreg(REG_D0, strlen(cmd));
  1597. #pragma msg 154 ignore
  1598.            *retvalue = (func)(); /* generates warning */
  1599. #pragma msg 154 warning
  1600.          } else /* version 36 or up! */
  1601.            *retvalue = RunCommand(seglist, 4000, cmd, strlen(cmd));
  1602.     
  1603.          UnLoadSeg( seglist );
  1604.        } else {
  1605.          /* we failed loading the command! */
  1606.          *retvalue = FUNCLIB_LOAD;
  1607.        }
  1608.     
  1609.     
  1610.        if(!*retvalue) {
  1611.          next = namelist->next;
  1612.          if(prevlist) /* was there a previous funclib in the list? */
  1613.            prevlist->next=next; /* point it to the next in the list */
  1614.          else
  1615.            scr->funclibs = next; /* point the origin to the next */
  1616.          FREEA(namelist->name); /* free name space */
  1617.          FREEA(namelist);       /* free struct */
  1618.          namelist = next;
  1619.          continue;
  1620.        }
  1621.      }
  1622.      prevlist = namelist;
  1623.      namelist = namelist->next;
  1624.    }
  1625.  
  1626.    FREE(cmd);
  1627.  
  1628.    return FPL_OK;
  1629. }
  1630.  
  1631. #endif
  1632.  
  1633. /**********************************************************************
  1634.  *
  1635.  * fplLtostr()
  1636.  *
  1637.  * Frontend to the FPL Ltostr() function to be used by anyone! The returned
  1638.  * string *must* be freed using the fplFreeString() function!
  1639.  *
  1640.  ****/
  1641.  
  1642. char * PREFIX
  1643. fplLtostr(AREG(0) struct Data *scr,
  1644.           DREG(0) long base,
  1645.           DREG(1) long num)
  1646. {
  1647.   ReturnCode ret;
  1648.   struct fplStr *string;
  1649.   char *retstring=NULL;
  1650. #ifdef DEBUGMAIL
  1651.   DebugMail(scr, MAIL_FUNCTION, 500, (void *)"fplLtostr");
  1652. #endif
  1653.   ret = Ltostr(scr, &string, base, num);
  1654.   if(FPL_OK == ret) {
  1655.     SwapMem(scr, string, MALLOC_STATIC); /* turn allocation to static type */
  1656.     retstring = string->string; /* return string pointer */
  1657.   }
  1658.   return retstring;
  1659. }
  1660.  
  1661.  
  1662. static ReturnCode REGARGS
  1663. Ltostr(struct Data *scr,
  1664.        struct fplStr **string,
  1665.        long base,
  1666.        long num)
  1667. {
  1668.   /*
  1669.    * Convert the integer to string with `any base'-convertions.
  1670.    */
  1671.   extern const char upper_digits[];
  1672.   ReturnCode ret;
  1673.   static const char *digits = upper_digits;
  1674.   long is_neg=num<0;
  1675.   long len=0;
  1676.   char buffer[34+sizeof(struct fplStr)];
  1677.   char *bufpoint;  /* the accurate position in the buffer */
  1678.  
  1679.   if(base>strlen(digits)) {
  1680.     CALL(Warn(scr, FPLERR_OUT_OF_REACH));
  1681.     num=strlen(digits); /* reset to maximum */
  1682.   }
  1683.   num=ABS(num);
  1684.     
  1685.   buffer[33+sizeof(struct fplStr)]=CHAR_ASCII_ZERO; /* zero byte termination */
  1686.   bufpoint=&buffer[33+sizeof(struct fplStr)]; /* start digit output position */
  1687.     
  1688.   if(num) {
  1689.     while(num>0) {
  1690.       *--bufpoint= digits[num % base];
  1691.       num /= base;
  1692.       len++;
  1693.     }
  1694.     if(is_neg) {
  1695.       *--bufpoint='-';
  1696.       len++;
  1697.     }
  1698.   } else {
  1699.     *--bufpoint=CHAR_ZERO;
  1700.     len++;
  1701.   }
  1702.  
  1703.   GETMEM(*string, len+sizeof(struct fplStr));
  1704.   strcpy((*string)->string, bufpoint);
  1705.   (*string)->len=len;
  1706.   (*string)->alloc=len;
  1707.   return(FPL_OK);
  1708. }
  1709.  
  1710. /**********************************************************************
  1711.  *
  1712.  * fplStrtol()
  1713.  *
  1714.  * Frontend to the FPL Strtol() function to be used by anyone!
  1715.  *
  1716.  ****/
  1717.  
  1718. long PREFIX
  1719. fplStrtol(AREG(0) char *string,
  1720.           DREG(0) long base,
  1721.           AREG(1) char **end)
  1722. {
  1723.   /*
  1724.    * THIS CAN'T CURRENT CALL DEBUGMAIL SINCE NO struct Data IS USED!!!
  1725.    */
  1726.   return Strtol(string, base, end);
  1727. }
  1728.  
  1729. /**********************************************************************
  1730.  *
  1731.  * Strtol()
  1732.  *
  1733.  * String to long integer. Code copied and changed from the GNU libc
  1734.  * source code package.
  1735.  *
  1736.  ****/
  1737.  
  1738. long REGARGS
  1739. Strtol(char *nptr,
  1740.        long base,
  1741.        char **end)
  1742. {
  1743.   char negative;
  1744.   unsigned long cutoff;
  1745.   unsigned long cutlim;
  1746.   long i;
  1747.   char *s;
  1748.   unsigned char c;
  1749.   char *save;
  1750.   long overflow;
  1751.  
  1752.   if (base < 0 || base == 1 || base > 36)
  1753.     base = 10;
  1754.  
  1755.   s = nptr;
  1756.  
  1757.   /* Skip white space.  */
  1758.   while(isspace(*s))
  1759.       s++;
  1760.  
  1761.   if (*s == CHAR_ASCII_ZERO)
  1762.     return (0);
  1763.  
  1764.   /* Check for a sign.  */
  1765.   else if (*s == CHAR_MINUS) {
  1766.     negative = 1;
  1767.     ++s;
  1768.   } else if (*s == CHAR_PLUS) {
  1769.     negative = 0;
  1770.     ++s;
  1771.   } else
  1772.     negative = 0;
  1773.  
  1774.   if ((base == 16 && s[0] == CHAR_ZERO && UPPER(s[1]) == CHAR_UPPER_X) ||
  1775.       (base == 2 && s[0] == CHAR_ZERO && UPPER(s[1]) == CHAR_UPPER_B) )
  1776.     s += 2;
  1777.  
  1778.   /* If BASE is zero, figure it out ourselves.  */
  1779.   if (base == 0)
  1780.     if (*s == '0') {
  1781.       switch(UPPER(s[1])) {
  1782.       case CHAR_UPPER_X:
  1783.     s += 2;
  1784.     base = 16;
  1785.     break;
  1786.       case CHAR_UPPER_B:
  1787.     s += 2;
  1788.     base = 2;
  1789.     break;
  1790.       default:
  1791.     base = 8;
  1792.     break;
  1793.       }
  1794.     } else
  1795.       base = 10;
  1796.  
  1797.   /* Save the pointer so we can check later if anything happened.  */
  1798.   save = s;
  1799.  
  1800.   cutoff = ULONG_MAX / (unsigned long int) base;
  1801.   cutlim = ULONG_MAX % (unsigned long int) base;
  1802.  
  1803.   overflow = 0;
  1804.   i = 0;
  1805.   for (c = *s; c; c = *++s) {
  1806.     if (isdigit(c))
  1807.       c -= '0';
  1808.     else if (isalpha(c))
  1809.       c = UPPER(c) - CHAR_UPPER_A + 10;
  1810.     else
  1811.       break;
  1812.     if (c >= base)
  1813.       break;
  1814.     /* Check for overflow.  */
  1815.     if (i > cutoff || (i == cutoff && c > cutlim))
  1816.       overflow = 1;
  1817.     else {
  1818.       i *= (unsigned long int) base;
  1819.       i += c;
  1820.     }
  1821.   }
  1822.  
  1823.   *end=s; /* this is the end position of the number */
  1824.  
  1825.   /* Check if anything actually happened.  */
  1826.   if (s == save)
  1827.     return (0);
  1828.  
  1829.   /* Check for a value that is within the range of
  1830.      `unsigned long int', but outside the range of `long int'.  */
  1831.   if (i > (negative ?
  1832.        - (unsigned long int) LONG_MIN :
  1833.        (unsigned long int) LONG_MAX))
  1834.     overflow = 1;
  1835.  
  1836.   if (overflow)
  1837.     return negative ? LONG_MIN : LONG_MAX;
  1838.  
  1839.   /* Return the result of the appropriate sign.  */
  1840.   return (negative ? - i : i);
  1841. }
  1842.  
  1843. /*****************************************************************************
  1844.  *
  1845.  * my_memicmp()
  1846.  *
  1847.  * This makes a case insensitive memcmp() with the very same parameters.
  1848.  *
  1849.  *********/
  1850.  
  1851. static long REGARGS my_memicmp(char *s1, char *s2, long len)
  1852. {
  1853.   long pos=0;
  1854.   long result;
  1855.   while(pos < len) {
  1856.     result = tolower(s1[pos]) - tolower(s2[pos]);
  1857.     if(result)
  1858.       return result;
  1859.     pos++;
  1860.   }
  1861.   return 0;
  1862. }
  1863.